perm filename XAP.FAI[1,BGB] blob sn#093404 filedate 1974-03-23 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00047 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00005 00002	TITLE XAP - XEROX ASSEMBLE AND PRINT - BGB - 27 JANUARY 1973.
C00006 00003	  ---	ASCII  00 TO  37 CHARACTER  ROUTINES.
C00008 00004	  ---	ASCII  40 TO  77 CHARACTER  ROUTINES.
C00009 00005	  ---	ASCII 100 TO 137 UPPER CASE ROUTINES.
C00011 00006	  ---	ASCII 140 TO 177 LOWER CASE ROUTINES.
C00012 00007	GLOBAL VARIABLES.
C00014 00008	FONT SPECIFICATION.
C00016 00009	RASTER SPECIFICATIONS.
C00018 00010	ALTERNATE PDP-10 MNEMONICS.
C00021 00011	SAIL LIKE SUBROUTINE LINKAGE.
C00024 00012	START ADDRESS ENTRY.
C00025 00013	SUBR(BEGPROG)		BEGIN PROGRAM.
C00027 00014	SUBR(MAIN)
C00030 00015	TWO DIMENSION BIT ADDRESSING.
C00034 00016	SUBR(XGPOUT)	OUTPUT BUFFER TO XGP FROM SECONDARY STORAGE.
C00037 00017	SUBR(PRINT)	PLACE A GLYPH INTO XGP BUFFER AT ROW,COL.
C00040 00018	TEXT JUSTFICATION MODES.
C00043 00019	SUBR(JUSTIFY)		PRINT A JUSTIFIED PARAGRAPH OF TEXT.
C00046 00020	SUBR(LNSCAN)	LINE SCAN FOR SPACES COUNT.
C00049 00021	SUBR(LNJUST)	LINE JUSTIFY AND PRINT.
C00052 00022	SUBR(TJLINE)	CENTER OR RIGHT JUSTIFY A LINE OF TEXT.
C00054 00023	SUBR(DEFONT)	DEFINE FONT NUMERAL N TAKES N FROM AC-1.
C00056 00024	SUBR(SETFNT)	SETUP A FONT, IMPLICIT ARGUMENT FONT.
C00058 00025	FONT SELECT DELIMITERS.
C00060 00026	SUBR(MKSEG0)	MAKE LINE SEGMENT.  CLIPPER.
C00063 00027	SUBR(MKSEG1)	MAKE LINE SEGMENT.
C00066 00028	SUBR(IIISIM)	OUTPUT III BUFFER ONTO XGP.
C00068 00029		FETCH AND DECODE III COMMAND WORD.
C00069 00030	EXECUTE III TEXT.
C00072 00031		EXECUTE VECTORS.
C00075 00032	
C00076 00033	SUBR(VIDEO)
C00080 00034	SUBR(GETFIL)	GET FILE SPECIFICATION - SKIP OK.
C00082 00035	SUBR(GETCHR)	GET A CHARACTER FROM THE TEXT BUFFER.
C00084 00036	SUBR(INFILE)	INDIRECT FILE COMMAND "@".
C00087 00037	COMMAND EXECUTION.
C00089 00038	XRADIAL:
C00092 00039	III DISPLAY SCALE FACTOR.
C00093 00040	SUBR(SQRT)
C00096 00041	READARC:	AND REALIN.
C00099 00042	SUBR(DPYDOT)X,Y		DISPLAY A DOT.
C00100 00043	SUBR(MKSEG3)
C00101 00044	SUBR(XCONIC)		E<A>,<B>,<X1>,<X2>
C00103 00045	SUBR(XBOX)
C00105 00046	SUBR(XSWINE)		MAKE BOX WITH ROUNDED CORNERS.
C00108 00047	SUBR(MKCURV)
C00109 ENDMK
C⊗;
TITLE XAP - XEROX ASSEMBLE AND PRINT - BGB - 27 JANUARY 1973.
;  ---	ASCII  00 TO  37 CHARACTER  ROUTINES.
;XWD TEXT_MODE,,COMMAND_MODE
A00:
	0	;null.					;00-07.
	0	;"↓"
	0	;"α"
	0	;"β"

	0	;"∧"
	0	;"¬"
	0	;"ε"
	0	;"π"

	XXLINE	;"λ"					;10↔17.
XWD %+HTAB,0	;tab.
XWD %+LFEED,0	;LF
	0	;VT.

XWD FFEED,FFEED	;FF.
XWD %+CRETURN,0	;CR.
	0	;"∞"
	0	;"∂"

XWD LFS+4,DFS+4	;"⊂"	LEFT FONT SELECT DELIMITER	;20-27.
XWD RFS+4,0	;"⊃"	RIGHT FONT SELECT DELIMITER
	0	;"∩"
	0	;"∪"

	0	;"∀"
	0	;"∃"
	IIISIM	;"⊗"	III DISPLAY BUFFER - CORNER ORIGIN.
	XARROW	;"↔"

	0	;"_"					;30-37.
	XARROW	;"→"
XWD ESCTXT,ESCCOM ;"~" TILDE.
	0	;"≠"

XWD LFS+5,DFS+5	;"≤"	LEFT FONT SELECT DELIMITER
XWD RFS+5,0	;"≥"	RIGHT FONT SELECT DELIMITER
	0	;"≡"
	0	;"∨"
;  ---	ASCII  40 TO  77 CHARACTER  ROUTINES.
;XWD TEXT_MODE,,COMMAND_MODE

XWD %+SPACE,0	;SPACE.					;40-47.
[SETOM BUGFLG↔POPJ 17,] ;"!"
	0	;"""
	0	;"#"

	0	;"$"
	0	;"%"
	0	;"&"
	0	;"'"

XWD LFS+2,DFS+2	;"("	LEFT FONT SELECT DELIMITER	;50-57.
XWD RFS+2,0	;")"	RIGHT FONT SELECT DELIMITER
	IIISIM	;"*"	III DISPLAY BUFFER - CENTER ORIGIN.
	0	;"+"

	0	;","
	0	;"-"
	0	;"."
	0	;"/"

	0	;"0"					;60-67.
	0	;"1"
	0	;"2"
	0	;"3"

	0	;"4"
	0	;"5"
	0	;"6"
	0	;"7"

	0	;"8"					;70-77.
	0	;"9~
	0	;":~
	SEMICO	;";~

	0	;"<"
	0	;"="
	0	;">"
	0	;"?"

;  ---	ASCII 100 TO 137 UPPER CASE ROUTINES.
;XWD TEXT_MODE,,COMMAND_MODE

	INFILE		;"@" 	INDIRECT FILE COMMAND		;100-107.
	XARRLW		;"A"	SET ARROW LENGTH,WIDTH
	XBOX		;"B"
	XCONIC		;"C"	CONIC ARCS

	XDIAMON		;"D"	DEBUG FLAG.
	XCONIC		;"E"
	XFONT		;"F"	SELECT FONT AND ENTER TEXT MODE.
	0		;"G"

	XCONIC		;"H"					;110-117.
	AI		;"I"	ABSOLUTE INVISIBLE VECTOR.
	XJUSTM		;"J"
	0		;"K"

	XLOCUS		;"L"
	DEFONT		;"M"	MAKE A FONT NUMBER.
	0		;"N"
	XROTAT		;"O"	SET ORIENTATION.

	0		;"P"					;120-127.
	FFEED		;"Q"
	XRADIAL		;"R"
	XSWINE		;"S"	MAKE ROUNDED BOX.

	0		;"T"
	0		;"U"
	AV		;"V"	ABSOLUTE VISIBLE VECTOR.
	XWINDO		;"W"

	XXSCAL		;"X"	SET X SCALE.			;130-137.
	YYSCAL		;"Y"	SET Y SCALE.
	0		;"Z"
XWD LFS+3,DFS+3		;"["	LEFT FONT SELECT DELIMITER

	0		;"\"
XWD RFS+3,0		;"]"	RIGHT FONT SELECT DELIMITER
	0		;"↑"
	XARROW		;"←"

;  ---	ASCII 140 TO 177 LOWER CASE ROUTINES.
;XWD TEXT_MODE,,COMMAND_MODE

	0		;"'"					;140-147.
	0		;"a"
	0		;"b"
	0		;"c"

	0		;"d"
	0		;"e"
	0		;"f"
	0		;"g"

	0		;"h"					;150-157.
	0		;"i"
	0		;"j"
	0		;"k"

	MUZAV		;"l"	;AV which uses co-ordinates as in Locus
	0		;"m"
	0		;"n"
	0		;"o"

	0		;"p"					;160-167.
	0		;"q"
	0		;"r"
	0		;"s"

	0		;"t"
	0		;"u"
	0		;"v"
	0		;"w"

	0		;"x"					;170-177.
	0		;"y"
	0		;"z"
XWD LFS+1,DFS+1		;"{"	LEFT FONT SELECT DELIMITER

	0		;"|"
	0		;alt
XWD RFS+1,0		;"}"	RIGHT FONT SELECT DELIMITER
	0		;rubout

;GLOBAL VARIABLES.

;JOB DATA AREA AND CORE MAP.
	PDL:	BLOCK 100	;CONTROL PUSH DOWN.
	PDLLEN←←.-PDL
	PAT:	BLOCK 100	;PATCH AREA.
	EXTERN JOBJDA	;140 END OF JOB DATA AREA.
	EXTERN JOBFF	;121 TOP OF USED CORE POINTER.
	EXTERN JOBSA	;120 XWD ORGINAL-TOP,START-ADDR.
	EXTERN JOBREL	; 44 PHYSICAL TOP OF CORE IMAGE.

;PROCESSOR STATUS.
	PASS:	0	; 0 FOR PASS1,     -1 FOR PASS2.
	CMODE:	0	;-1 COMMAND MODE.   0 TEXT MODE.

	CHAR:	0	;CURRENT CHARACTER.
	CHRCNT:	0	;CHARACTERS REMAINING.
	ESC:	32	;ESCAPE CHARACTER - DEFAULT TILDE.

	TXTPTR:	0	;TEXT POINTER.
	TXTORG:	0	;TEXT ORIGIN.
	TXTEND:	0	;END OF TEXT BUFFER.

	XLINE:	5	;EXTRA LINES BETWEEN ROWS OF CHARACTERS

	EOF:0↔HIDDEN:0
	EOP:0		;END OF PAGE FLAG.
	BUGFLG:0	;-1 WHEN DEBUGGING.

;DSK I/O DATA AREA.
	FILNAM:	0	;FILE NAME.
	EXTION:	0↔0	;EXTENSION.
	PPPN:	0↔0	;PROJECT-PROGRAMMER.
;FONT SPECIFICATION.

	FONT: 1
	FONTAB: BLOCK =45
	FNTPPN:	SIXBIT/XGPSYS/		;DEFAULT FONT PPN

;DEFAULT FONT NUMERAL NAMES.

FNTNAM: 0		;0	"RON ZIEGLER" FONT.
	SIXBIT/LPT/	;1	LINE PRINTER.
	SIXBIT/FIX13X/	;2	FIXED WIDTH FONTS.
	SIXBIT/FIX20/	;3
	SIXBIT/FIX25/	;4
	SIXBIT/FIX30/	;5
	SIXBIT/FIX40/	;6

	SIXBIT/NGR13/	;7	NEW GOTHIC ROMAN.
	SIXBIT/NGR20/	;8
	SIXBIT/NGR25/	;9
	SIXBIT/NGR30/	;A
	SIXBIT/NGR40L/	;B

	SIXBIT/BDR25/	;C	BODONI ROMAN
	SIXBIT/BDI25/	;D	BODONI ITALIC

	SIXBIT/XMAS25/	;E	PSEUDO OLDE ENGLISH.
	SIXBIT/SIGN57/	;F
	SIXBIT/GRK25/	;G	GREEK.
	SIXBIT/SET1/	;H	TOVAR'S CREATION.
	SIXBIT/SUB/	;I
	SIXBIT/SUP/	;J
	BLOCK ("Z"-"H")	;TO Z -	EMPTY SPACE.

COMMENT ⊗ STANFORD FONT FILE FORMAT.---------------------------------

WORDS 0-177:
	XWD CHARACTER_WIDTH,CHARACTER_ADDRESS
WORDS 200-237:
	CHARACTER_SET_NUMBER
	HEIGHT
	MAX_WIDTH (IN BITS)
	BASE LINE (BITS FROM TOP OF CHARACTER)
WORDS 240-377:
	ASCIZ/FONT DESCRIPTION/
REMAINDER OF FILE:
	    EACH CHARACTER:
		CHARACTER_CODE,,WORD_COUNT+2
		ROWS_FROM_TOP,,DATA_ROW_COUNT
		BLOCK WORD_COUNT
--------------------------------------------------------------------⊗
;RASTER SPECIFICATIONS.

;XGP RASTER PAGE BUFFER.
	ROW:0		;XGP "PEN" POSITION.
	COL:0
	DROW:0		;DELTA PEN POSITION FOR LINE FEED AND SPACE.
	DCOL:0	
	QPAGE:0		;QUARTER PAGE: 0, 1, 2, 3.
	QLO:0↔QHI:0	;QUARTER ROW LOW & QUARTER ROW HI.
	ORGXGP:0	;XGP BUFFER (1/4 OF A PAGE).
	ENDXGP:0

;XGP RASTER DIMENSIONS.
	WWIDTH←←=49		;WORD WIDTH OF A ROW.
	NCOLS←←(WWIDTH-1)*=36	;NUMBER OF COLUMNS	IS 1728.
	MROWS←←=2048		;NUMBER OF ROWS		IS 2048.
        BUFSIZ←←WWIDTH*MROWS/4	;SIZE OF XGP BUFFER (ONE QUARTER PAGE).

;III BUFFER DISPLAY.
	IIIDX: =1024
	IIIDY: =1024
	ROTDEL:0
	SINE:0↔COSINE:1.0	;ORIENTATION.
	SCALEX:1.0↔SCALEY:1.0	;DILATION.

;TEXT JUSTIFICATION PARAMETERS.
	COLMIN:↔LMAR:	=200		;OF 1728 COLUMNS.
	COLMAX:↔RMAR:	=1500
	ROWMIN:		=200		;OF 2048 ROWS.
	ROWMAX:		=2000
	TJMODE:	-1			;AUTO CRLF MODE.
	TJFLAG:	 0			;-1 CENTER, +1 RIGHT JUSTIFICATION.
;ALTERNATE PDP-10 MNEMONICS.
	DEFINE O(A,B){OPDEF A[B]}
	O LIP,HLR↔O LAP,HRR↔O DIP,HRLM↔O DAP,HRRM
	O ZIP,HRRZS↔O ZAP,HLLZS↔O WIP,HRROS↔O WAP,HRRZS
	O CAR,HLRZ↔O LIPI,HRLI↔O LAPI,HRRI↔O DIPZ,HRLZM
	O CDR,HRRZ↔O LACI,MOVEI↔O SLACI,MOVSI↔O DAPZ,HRRZM
	O LAC,MOVE↔O LACN,MOVN↔O LACM,MOVM↔O SLAC,MOVS
	O DAC,MOVEM↔O DACN,MOVNM↔O DACM,MOVMM↔O SDAC,MOVSM
	O NIP,HLRE↔O NAP,HRRE↔O NIM,HRREI↔O GO,JRST
	O FLOAT,FSC 233↔O FIXX,FIX 233000↔O DZM,SETZM↔O DOM,SETOM
	O JCALL,JRST↔O ZAC,SETZ↔O WAC,SETO

;MAKE RAID KNOW THE FOLLOWING
	O(FIX,FIX)↔O(HALT,HALT)
	O(INCHRW,INCHRW)↔O(INCHWL,INCHWL)
	O(OUTCHR,OUTCHR)↔O(OUTSTR,OUTSTR)
	O(JRSTF,{JRST 2,})↔O(JCALL,{JRST 1,})↔O(PGCLR,{PGIOT 2,})

;RETURN FROM AN N-ARGUMENT SUBROUTINE CALL.

	↓P←←17↔DEFINE POP0J <POPJ P,>
	↓POP1J.:SUB P,[2(2)]↔GO@2(P)↔DEFINE POP1J<GO POP1J.>
	↓POP2J.:SUB P,[3(3)]↔GO@3(P)↔DEFINE POP2J<GO POP2J.>
	↓POP3J.:SUB P,[4(4)]↔GO@4(P)↔DEFINE POP3J<GO POP3J.>
	↓POP4J.:SUB P,[5(5)]↔GO@5(P)↔DEFINE POP4J<GO POP4J.>

;MACROS TO SAVE AND RESTORE AC'S  -  SAVAC, GETAC, PUSHACS, POPACS.
	DEFINE SAVAC $(N){LAC[XWD 2,AC2]↔BLT AC$N}
	DEFINE GETAC (N){LAC[XWD AC2,2]↔BLT N}
	IFNDEF PUSHIT<
	DEFINE PUSHACS<PUSHJ P,PUSHIT↑
	GLOBAL .PLEVEL↔.PLEVEL←←.PLEVEL+20>
	DEFINE POPACS<PUSHJ P,POPIT↑
	GLOBAL .PLEVEL↔.PLEVEL←←.PLEVEL-20>>

;ACCUMULATOR AND TEMPORARY DATA MANAGEMENT.

	DEFINE ACCUMULATORS(LIST){ACPTR←←2
	FOR AC⊂(LIST)<AC←ACPTR↔ACPTR←←ACPTR+1↔>}
	DEFINE DECLARE (LIST){
	FOR VARNAM⊂(LIST)<VARNAM: 0↔>}

;FATAL ERROR MESSAGE.

	DEFINE FATAL(STR){PUSHJ 17,FATAL.↔ASCIZ/STR/}
	FATAL.:OUTSTR[BYTE(7)15,12(21)"FAT"↔"AL - "⊗1↔0]
	OUTSTR @(17)↔INCHRW↔GO .-1↔LIT
	DEFINE CRLF{OUTSTR[BYTE(7)15,12]}
	%←←400000
;SAIL LIKE SUBROUTINE LINKAGE.
	DEFINE ARG1<-1(P)>↔DEFINE ARG2<-2(P)>
	DEFINE ARG3<-3(P)>↔DEFINE ARG4<-4(P)>
	DEFINE CAT $(A,B){A$B}	;CONCATENATION.
	.PLEVEL←←0	;PDL BACK POINTER.
	.SLEVEL←←0	;DEPTH OF NESTED SUBROUTINE DECLARATIONS.

;SUBROUTINE DECLARATION MACROS  -  SUBR & ENDR.
;(Reminder: Right-arrow, "→" is FAIL's macro arg EVAL).
	DEFINE SUBR(NAME,X1,X2,X3,X4,X5)↔{BEGIN NAME↔INTERN NAME
	GLOBAL .PLEVEL↔GLOBAL .SLEVEL↔.SLEVEL←←.SLEVEL+1
	CAT(.SBR,→.SLEVEL)←←.PLEVEL     ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X1>{DEFARG(X1,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X2>{DEFARG(X2,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X3>{DEFARG(X3,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X4>{DEFARG(X4,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X5>{DEFARG(X5,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1}}}}}
	XWD 777000+.PLEVEL-CAT(.SBR,→.SLEVEL)-1,[SIXBIT|NAME|]↔↓NAME:;}

;DEFINE ARGUMENT NAME MACRO.
	DEFINE DEFARG(NAME,LEVEL){DEFINE NAME{LEVEL-.PLEVEL(17)}}

;SUBROUTINE TERMINATION MACRO.
	DEFINE ENDR{.PLEVEL←←CAT(.SBR,→.SLEVEL)
	.SLEVEL←←.SLEVEL-1↔LIT↔BLOCK 0↔BEND }

;SUBROUTINE CALLING MACROS  -  CALL & SETQ.
	DEFINE CALL(NAME,X1,X2,X3,X4,X5)
	{GLOBAL .SLEVEL,.PLEVEL↔.SLEVEL←←.SLEVEL+1
	CAT(.SBR,→.SLEVEL)←←.PLEVEL
	IFDIF<><X1>{PUSH P,X1↔.PLEVEL←.PLEVEL+1
	IFDIF<><X2>{PUSH P,X2↔.PLEVEL←.PLEVEL+1
	IFDIF<><X3>{PUSH P,X3↔.PLEVEL←.PLEVEL+1
	IFDIF<><X4>{PUSH P,X4↔.PLEVEL←.PLEVEL+1
	IFDIF<><X5>{PUSH P,X5↔.PLEVEL←.PLEVEL+1 }}}}}
	IFDIF<><NAME>{PUSHJ P,NAME }
	.PLEVEL←←CAT(.SBR,→.SLEVEL)↔.SLEVEL←←.SLEVEL-1}
	DEFINE SETQ(VAR,LIST){CALL(LIST)↔DAC 1,VAR}

;STACK ACCESSING MACROS  -  PUSHP & POPP.
	DEFINE PUSHP(ARG){PUSH P,ARG↔.PLEVEL←←.PLEVEL+1}
	DEFINE POPP(ARG) {POP  P,ARG↔.PLEVEL←←.PLEVEL-1}
;START ADDRESS ENTRY.

SA:	CALLI
	CAR JOBSA↔DAC JOBFF↔CORE↔JFCL	;CORE DOWN LOWER.
	LACI =2047↔CORE2↔GO[
	FATAL(<CAN'T GET A 2ND SEGMENT.>)]
	LAC P,[IOWD PDLLEN,PDL]		;CONTROL PUSHDOWN.

;RE-ENTRY ADDRESS.

REE:	LACI .↔DAC 124
	LAC P,[IOWD PDLLEN,PDL]		;CONTROL PUSHDOWN.

;EXECUTION.

	CALL(BEGPROG)			;PROGRAM INITIALIZATION.
	CALL(MAIN)			;MAIN PROGRAM EXECUTION.

;END PROGRAM.

	CALLI			;FLUSH THE TWO LIBRASCOPE BANDS.
	LAC JOBFF↔CORE↔JFCL	;FLUSH THE 25K TO 50K OF EXTRA CORE.
	SETZ↔CORE2↔JFCL		;FLUSH UPPER SEGMENT OF FONT FILES.
	EXIT
;--------------------------------------------------------------------
SUBR(BEGPROG)		;BEGIN PROGRAM.
;--------------------------------------------------------------------
	LACI 0↔UFBGET↔GO .+3
	LACI 1↔UFBGET↔GO[FATAL(<CAN'T GET FASTBANDS.>)]

;DEFAULT INITIALIZE MARGINS.
	LAC ROWMIN↔DAC ROW	;XGP PEN POSITION.
	LAC COLMIN↔DAC COL

;INITIALIZE SCANNER AND CORE ALLOCATION.
	DOM CMODE		;COMMAND MODE.
	CALL(MKBUF)		;MAKE XGP BUFFER.
	CALL(MKTABL)		;MAKE 2D BIT ADDRESS TABLE.

;DEFINE DEFAULT FONT.
	DZM FONTAB
	LAC[XWD FONTAB,FONTAB+1]↔BLT FONTAB+9
	LAC[SIXBIT/LPTFNT/]
	HLLZM FILNAM↔DIPZ EXTION
	LAC FNTPPN↔DAC PPPN
	LACI 1↔DAC FONT
	CALL(<DEFONT+1>)

;RESCAN COMMAND LINE FOR CHARACTERS RIGHT OF SEMI-COLON.
	RESCAN↔INCHSL↔EXIT↔CAIN 15↔EXIT
	CAIE";"↔GO .-5↔DZM CHRCNT
	CDR JOBFF↔LIPI 440700		;TEXT BUFFER POINTER.
	DAC TXTPTR↔DAC TXTORG
	INCHSL 1↔EXIT			;READ FIRST CHARACTER.
	DZM BUGFLG↔CAIN 1,"!"
	DOM BUGFLG↔GO .+3
	INCHSL 1↔GO .+4↔AOS CHRCNT	;READ REMAINING CHARACTERS.
	IDPB 1,0↔GO .-4↔DAC TXTEND
	SKIPN BUGFLG↔POP0J
	OUTSTR[ASCIZ/BEGIN./]
	INCHRW↔CRLF↔POP0J
ENDR BEGPROG;--------------------------------------------------------
SUBR(MAIN)
;--------------------------------------------------------------------
;START-OF-DOCUMENT.
	LAC TXTORG↔DAC TXTPG#↔DZM EOF
	CDR 1,TXTEND↔CDR 0,TXTORG
	SUB 1,0↔AOS 1↔IMULI 1,5↔DAC 1,CHRCNT
	LAC CHRCNT↔DAC SAVCNT
;START-OF-PAGE.
L0:	LACI =511↔DAC QHI↔DZM QLO↔DZM QPAGE	;1ST QUARTER PAGE.
L00:	LAC TXTPG↔DAC TXTPTR↔DZM EOP
	DOM CMODE↔DZM EOF	;TOP-OF-THE-PAGE.
	LAC SAVCNT↔DAC CHRCNT
	LAC ROWMIN↔DAC ROW
	LAC COLMIN↔DAC COL
	LAC ORGXGP↔DZM@↔DIP↔AOS↔BLT@ENDXGP	;CLEAR QUARTER PAGE.
;PROCESS A CHARACTER.
L1:	SKIPE EOP↔GO L3			;END OF PAGE ?
	SETQ(CHAR,{GETCHR})		;FETCH A CHARACTER.
	SKIPE EOF↔GO L3			;END OF DOCUMENT DOCUMENT ?
	SKIPE CMODE↔GO L2		;TEXT OR COMMAND MODE ?
	CAR 0,A00(1)↔TRZ %↔JUMPE 0,.+3	;TEXT MODE CHARACTER.
	CALL(@0)↔GO L1			;TEXT MODE SUBROUTINES.
	CALL(PRINT)↔GO L1		;PRINT UNJUSTIFIED CHARACTER.
L2:	CDR A00(1)			;COMMAND MODE CHARACTER.
	SKIPE↔PUSHJ P,@0↔GO L1		;EXECUTE A COMMAND.

;WRITE QUARTER OF A PAGE ON LIBRASCOPE.
L3:	LAC 1,QPAGE↔LAC[0↔=784↔=1568↔0](1)↔DAC SECTOR
	LAC ORGXGP↔DAC BUFPTR↔	LACI =25088↔DAC WRDCNT
	LAC[0↔0↔0↔1](1)↔DAC BAND
	FBWRT BUFPTR↔OUTSTR[ASCIZ/WARNING: FB WRITE ERROR./]
;ADVANCE TO NEXT QUARTER PAGE.
	LACI =512↔ADDM QLO↔ADDM QHI
	AOS 1,QPAGE↔CAIGE 1,4↔GO L00
;ADVANCE TO NEXT PAGE.
L4:	CALL(XGPOUT)
L4A:	CRLF
	LAC TXTPTR↔DAC TXTPG
	LAC CHRCNT↔DAC SAVCNT
	SKIPN EOF↔GO L0
	POP0J
ENDR MAIN;-----------------------------------------------------------
SAVCNT:0
;TWO DIMENSION BIT ADDRESSING.
DEFINE DOT(R,C){HLLZ 1,%(C)↔ROT 1,6↔HRRI 1,@%(R)↔DPB 0,1}
COMMENT ⊗
	The DOT macro places a  bit at a given row and  column of the
XGP  buffer. The  2D bit  address byte pointer  is computed  by twice
referencing a  2K table  in which  the Nth  word  contains the  bytes
0:5(N  div =36)  6:11(N  mod  =36) 12:17(01)  18:35(orgXGP+N*WWIDTH).
That  is the left halfword  of the Nth table  entry contains the base
address of  the Nth  row; and  the right  halfword of  the Nth  table
entry contains  a byte pointer to  the Nth column. In  the DOT macro,
the HLLZ and ROT instructions setup  the column byte pointer and  the
HRRI  instruction  (thru  the  magic  of  immediate  indirect  double
indexing) adds the right halfword  of the Nth row  table entry to the
byte pointer. The use  of accumulator 1  is mandatory because of  the
index-byte-size pun. The following subroutine initializes the table.⊗

SUBR(MKTABL)	;MAKE 2D BIT ADDRESSING TABLE IN 2ND SEGMENT.
;--------------------------------------------------------------------
	LAC[XWD L,1]↔BLT 11
	LAC ORGXGP↔AOS↔TLO 4301↔PUSHJ P,3
	LAP ORGXGP↔AOS↔LIPI 2,-=512↔PUSHJ P,3
	LAP ORGXGP↔AOS↔LIPI 2,-=512↔PUSHJ P,3
	LAP ORGXGP↔AOS↔LIPI 2,-=512↔GO 3
L:	XWD -100,WWIDTH		;1	INCREMENT.
	XWD -=512,%		;2	AOBJN TABLE POINTER.
	DAC 0,(2)		;3
	TLNN 0,7700		;4	TEST FOR =36 OVERFLOW.
	ADD 0,[144B11]		;5	INCREMENT COLUMN WORD COUNT.
	ADD 0,1			;6
	AOBJN 2,3		;7
	POP0J			;8
ENDR MKTABL;BGB 24 MAY 1973._________________________________________

SUBR(MKBUF)	MAKE XGP BUFFER (ONE PHASE) 512 ROWS.
;--------------------------------------------------------------------

;EXPAND CORE FOR XGP BUFFER.
	CDR JOBFF↔DAC ORGXGP
	ADDI BUFSIZ-1↔DAC ENDXGP
	ADDI 3*WWIDTH+10↔DAC JOBFF↔ADDI =3000
 	CORE↔GO[FATAL(CAN'T GET CORE FOR XGP BUFFER)]

;CLEAR XGP BUFFER.
	LAC 1,ORGXGP↔SETZM(1)
	DIP 1,1↔AOS 1↔BLT 1,@JOBREL
	POP0J

ENDR MKBUF;BGB 27 JANUARY 1973.-----------------------------------
SUBR(XGPOUT)	OUTPUT BUFFER TO XGP FROM SECONDARY STORAGE.
;--------------------------------------------------------------------
	BSIZ ←← =6272 ↔ BCNT ←← =16 ;BUFFER SIZE & NUMBER OF THEM.
	SETZ 1,↔SEGNUM 1,↔DAC 1,MYSEG#↔DETSEG	     ;DETACH SEGMENT.
L0:	INIT 2,117↔SIXBIT/XGP/↔0↔GO[OUTSTR[ASCIZ/XGP INIT FAILED.
/]↔	POP0J]↔LOCK
	OUTSTR[ASCIZ/PAGE TO XGP.../]
	LAC ORGXGP↔DAC BUFORG		;SETUP AN OUTPUT BUFFER.
	ADDI 3*BSIZ↔DAC BUFEND
	CAMLE JOBREL↔CORE↔JFCL
	DZM BAND↔DZM SECTOR		;FIRST BAND AND SECTOR.
	LAC BUFORG↔DAC BUFPTR
	LACI 3,BCNT			;DRUM BUFFERS PER PAGE.
;READ DRUM.
L1:	LACI BSIZ↔DAC WRDCNT↔LAC BAND
	FBREAD BUFPTR↔OUTSTR[ASCIZ/FAST BAND READ ERROR. /]
	LACI =196↔ADDB SECTOR↔CAIG =2156↔GO .+3↔DZM SECTOR↔AOS BAND
;PUT XGP CONTROL WORD IN EACH ROW.
	LAC[1B11+=48]↔LAC 1,BUFPTR↔LACI 2,=128
	DAC(1)↔ADDI 1,=49↔SOJG 2,.-2
	CAIE 3,BCNT↔GO L2
	OUT 2,CUT1

;PRINT ON XGP.
L2:	SLACI -BSIZ↔LAP BUFPTR↔SOS↔ASH 3,1↔DAC DUMARG(3)
	OUT 2,DUMARG(3)↔STATZ 2,2000↔GO[
	OUTSTR[ASCIZ/XGP LOSSAGE, TRY AGAIN ?
/]↔RELEASE 2,↔UNLOCK↔INCHRW↔caie"y"↔CAIN"Y"↔GO L0↔GO L5]
	ASH 3,-1↔CAIE 3,1↔GO L3
	OUT 2,CUT2

;ADVANCE TO NEXT BUFFER.
L3:	LACI BSIZ↔ADDB BUFPTR↔CAMGE BUFEND↔GO L4
	LAC BUFORG↔DAC BUFPTR
L4:	SOJG 3,L1↔UNLOCK↔RELEASE 2,↔OUTSTR[ASCIZ/FINISHED./]
L5:	CRLF↔LAC 1,MYSEG↔JUMPE 1,.+3		;RE-ATTACH SEGMENT.
	ATTSEG 1,↔GO[OUTSTR[ASCIZ/ATTSEG FAILED. /]↔HALT .+1]
	POP0J
;--------------------------------------------------------------------
	BUFORG:0↔BUFEND:0		;XGP BUFFERS.
	DUMARG:BLOCK BSIZ*2 + 4
CUT1:	IOWD 3,HACK1↔0
CUT2:	IOWD 2,HACK2↔0
HACK1:	1B0 ↔ =75B11 ↔ 0	;CUT AT THE TOP AND THEN MOVE.
HACK2:	=75B11 ↔ 1B0 ↔ 0	;MOVE AND THEN CUT AT THE BOTTOM.
ENDR XGPOUT;BGB 28 MAY 1973.--------------------------------------
	BAND:0↔BUFPTR:0↔WRDCNT:=12544↔SECTOR:0	;FB UUO ARGUMENT.
SUBR(PRINT)	PLACE A GLYPH INTO XGP BUFFER AT ROW,COL.
;--------------------------------------------------------------------
;Implicit Arguments to PRINT are ROW, COL, CHAR,
;FONT, FONTAB, ORGXGP, ENDXGP, TJMODE.
	ACCUMULATORS{G,B,B2,M,N,I,X16}
	SKIPN CHAR↔POP0J	;IGNORE NULL CHARACTERS.
	LAC 1,FONT		;CURRENT FONT NUMBER.
	SKIPN 2,FONTAB(1)↔POP0J	;FONT BASE ADDRESS.
	LAC I,203(2)		;ROWS BETWEEN TOP AND BASE LINE.
	ADD 2,CHAR		;POINTER INTO FONT'S CHARACTER TABLE.
	CAR N,(2)		;COLS WIDE OF THE GLYPH.
	CDR G,(2)↔SKIPN G↔POP0J ;EXIT WHEN NO CHARACTER.
	ADD G,FONTAB(1)↔AOS G	;CHARACTER'S GLYPH POINTER.
	CDR M,(G)		;ROWS HIGH OF THE GLYPH.
	CAR 0,(G)		;ROWS FROM TOP TO FIRST ROW OF GLYPH.
	SUB 0,I			;ROWS ABOVE CURRENT XGP PEN POSITION.
	ADD 0,ROW↔SUB 0,QLO
	IMULI WWIDTH
	ADD ORGXGP↔DAPZ B	;WORD POINTER INTO XGP BUFFER.
	LAC 0,COL
	SKIPE TJMODE↔GO .+3	;CLIP LINE OVERFLOW IF TJMODE=0
	CAML 0,RMAR↔POP0J
	IDIVI 0,=36		;REMAINDER IN AC-1 !
	AOS↔ADD B,0↔DAC B,B2	;WORD POINTER INTO XGP BUFFER.
 	ADDM N,COL		;UPDATE XGP PEN COLUMN POSITION.
	TLO G,444400↔AOS G	;SETUP GLYPH BYTE POINTER.
	CAILE N,=36↔GO[
	IDIVI N,=36↔AOJA N,L0]	;WHEN CHARACTER WIDTH ≥ =36.
	DPB N,[POINT 6,G,11]	;SIZE OF BYTE.
	ADD 1,N↔SUBI 1,=36	; =36 - CHRWID - REMAINDER
	LACI N,1
L0:	MOVNS 1↔DAP 1,L3	;BYTE POSITION WITH RESPECT TO WORD BOUNDARYS.

;INCLUSIVE OR GLYPH BITS INTO THE XGP BUFFER.

L1:	LAC I,N
L2:	ILDB 0,G↔SETZ 1,
L3:	LSHC 0,0
	CAML B,ORGXGP↔CAMLE B,ENDXGP↔SKIPA↔IORM 0,(B)
	AOS B↔JUMPE 1,L4
	CAML B,ORGXGP↔CAMLE B,ENDXGP↔SKIPA↔IORM 1,(B)
L4:	SOJG I,L2↔LAC B,B2
	ADDI B,WWIDTH↔DAC B,B2
	SOJG M,L1
	POP0J
ENDR PRINT;5/23/73(BGB)----------------------------------------------
;TEXT JUSTFICATION MODES.
;TJMODES:	;-1	JA	AUTO CRLF DEFAULT.
		; 0	JV	VIDEO CLIPPED MODE.
		;+1	JU	JUSTIFY MODE.
;TJFLAG:	;-1	JC	CENTER JUSTIFY A LINE.
		;+1	JR	RIGHT JUSTIFY A LINE.
;EXECUTE "J" COMMAND.------------------------------------------------
XJUSTM:	CALL(GETCHR)↔LACI 1
	CAIN 1,"A"↔DOM TJMODE		;JUSTIFY AUTOMATIC CRLF.
	CAIN 1,"V"↔DZM TJMODE		;JUSTIFY VIDEO.
	CAIN 1,"U"↔DAC TJMODE		;JUSTIFY.
	CAIN 1,"C"↔DOM TJFLAG		;JUSTIFY CENTER.
	CAIN 1,"R"↔DAC TJFLAG		;JUSTIFY RIGHT.
	POP0J
;--------------------------------------------------------------------
SPACE:
	LAC 1,FONT		;THE FONT.
	SKIPN 1,FONTAB(1)↔HALT
	CAR 0," "(1)		;THE WIDTH OF A SPACE.
	ADDM 0,COL		;NEW CARRIAGE POSITION.
	POP0J
CRETURN:
	LAC 1,COLMIN
	DAC 1,COL
	POP0J
LFEED:
	LAC 1,FONT
	SKIPN 1,FONTAB(1)↔HALT
	LAC 1,201(1)	;MAXIMUM HEIGHT.
	ADD 1,XLINE
	ADDM 1,ROW
	POP0J
HTAB:
	LAC 1,FONT		;THE FONT.
	SKIPN 1,FONTAB(1)↔HALT
	CAR 0," "(1)		;THE WIDTH OF A SPACE.
	LAC 1,COL↔SUB 1,COLMIN	;CARRIAGE POSITION.
	IDIV 1,0↔ANDCMI 1,7	;THE OCTADE OF THE NUMBER OF SPACES.
	ADDI 1,8		;NEXT OCTADE.
	IMUL 1,0		;NEW CARRIAGE POSITION.
	ADD  1,COLMIN↔DAC 1,COL
	SKIPLE TJMODE		;SKIP WHEN MODE IS -1 OR 0.
	JCALL JUSTIFY
	POP0J
ESCTXT:	DOM CMODE↔POP0J		;ESCAPE TEXT - ENTER COMMAND MODE.
ESCCOM: DZM CMODE
	POP0J			;ESCAPE COMMAND  - ENTER TEXT MODE.
FFEED:	DOM EOP↔POP0J
XXLINE:	CALL(REALIN)↔FIXX↔DACM XLINE↔POP0J
XWINDO:	CALL(REALIN)↔FIXX↔DACM COLMIN
	CALL(REALIN)↔FIXX↔DACM COLMAX↔POP0J
SUBR(JUSTIFY)		;PRINT A JUSTIFIED PARAGRAPH OF TEXT.
COMMENT ⊗------------------------------------------------------------
	A justified paragraph begins with a TAB and ends with one of
five possible terminations: 1. end of file; 2. escape character;
3. form feed; 4. CRLF-TAB; 5. CRLF-CRLF. The main role of this routine
is to find the end of the paragraph; then it calls LNSCAN and LNJUST
until all the full lines are printed. 
;-------------------------------------------------------------------⊗
	PUSH P,TXTPTR		;SAVE INITIAL STATE OF THE SCANNER.
	PUSH P,CHRCNT
L1:	LAC TXTPTR↔DAC ENDPTR	;SAVE PTR TO POTENTIAL END CHARACTER.
	CALL(GETCHR)
	SKIPE  EOF↔GO L2	;1. END OF FILE EXCLUSIVE.
	CAMN 1,ESC↔GO L2	;2. ESCAPE CHARACTER EXCLUSIVE.
	CAIN 1,14 ↔GO L2	;3. FORM FEED EXCLUSIVE.
	CAIE 1,15 ↔GO L1	;SKIP ON 1ST CARRIAGE RETURN.

;CARRIAGE RETURN LOOK AHEAD.
	LAC  0,TXTPTR
	ILDB 1,0↔CAIE 1,12↔GO L1	;LINE FEED INCLUSIVE.
	DAC  0,ENDPTR
	ILDB 1,0↔CAIN 1,11↔GO L2	;4. CRLF TAB.
 	         CAIE 1,15↔GO L1	;2ND CARRIAGE RETURN.
	ILDB 1,0↔CAIE 1,12↔GO L1	;5. CRLF CRLF.

;FOUND END OF PARAGRAPH (INCLUSIVE AND EXCLUSIVE).
L2:	POP P,CHRCNT		;RESTORE SCANNER TO INITIAL POSITION.
	POP P,TXTPTR

;PRINT ALL THE FULL LINES OF THE PARAGRAPH.
L3:	CALL(LNSCAN)			;LINE SCAN FOR SPACES.
	CALL(LNJUST)			;LINE JUSTIFY AND PRINT.
	LAC TXTPTR↔CAME ENDPTR↔GO L3	;TEST FOR END OF PARAGRAPH.
	POP0J

;BYTE POINTER TO LAST CHARACTER OF THE PARAGRAPH INCLUSIVE.
	↑ENDPTR: 0	;IMPLICIT ARGUMENT FOR LNSCAN.
ENDR JUSTIFY;9/20/73(BGB)--------------------------------------------
SUBR(LNSCAN)	;LINE SCAN FOR SPACES COUNT.
COMMENT ⊗------------------------------------------------------------
	Scan for left margin overflow, while keeping track of the
number of spaces seen and the position of the last space seen.
--------------------------------------------------------------------⊗
	ACCUMULATORS{CHR}
;INITIALIZATION.
	LAC COL↔DAC COLUMN		;TJ LEFT MARGIN.
	DZM SPACNT↔DZM SPAPTR↔DZM SPACOL
	LAC TXTPTR↔DAC LNPTR
	DZM SPAFLG			;IGNORE LEADING SPACES.
;TEST FOR END OF LINE SCAN.
L1:	LAC LNPTR↔CAMN ENDPTR↔GO[	;EXIT END OF PARAGRAPH.
	DZM SPAPTR↔DZM SPACNT↔POP0J]
	LAC COLUMN↔CAML COLMAX↔POP0J	;EXIT LINE FULL.

;FETCH A CHARACTER.
	ILDB CHR,LNPTR
	CAIN CHR,12↔GO L1	;IGNORE LINEFEEDS.
	CAIN CHR,00↔GO L1	;IGNORE NULLS.
	CAIN CHR,11↔LACI CHR,40	;CONVERT TAB INTO A SPACE.
	CAIN CHR,15↔LACI CHR,40	;CONVERT CR  INTO A SPACE.
;SAVE THE STATUS OF THE LATEST SPACE.
	CAIE CHR,40↔GO L2
	AOSE SPAFLG↔GO L1	;IGNORE MULTIPLE SPACES.
	AOS SPACNT		;INCREMENT SPACE COUNT.
	LAC COLUMN↔DAC SPACOL	;SAVE SPACE POSITION.
	LAC LNPTR↔DAC SPAPTR	;SAVE SPACE BYTE POINTER.
	LAC 1,FONT↔LAC 1,FONTAB(1)	;FONT BASE ADDRESS.
	ADD 1,CHR↔CAR 0,(1)		;WIDTH OF SPACE.
	SKIPE DOUBLE↔ASH 0,1		;DOUBLE WIDTH SPACE.
	ADDB 0,COLUMN↔GO L1

;ACCUMULATE CHARACTER WIDTHS - NOT SPACE.
L2:	DOM SPAFLG#↔DZM DOUBLE#
	CAIN CHR,"."↔DOM DOUBLE
	CAIN CHR,"?"↔DOM DOUBLE
	LAC 1,FONT↔LAC 1,FONTAB(1)	;FONT BASE ADDRESS.
	ADD 1,CHR↔CAR 0,(1)		;WIDTH OF CHARACTER.
	ADDB 0,COLUMN↔GO L1

;GLOBAL VARIABLES FOR COMMUNICATION TO LNJUST.
	↑LNPTR:	0	;END OF LINE POINTER.
	↑SPACNT:0	;SPACE COUNT.
	↑SPAPTR:0	;BYTE POINTER TO LATEST SPACE.
	↑SPACOL:0	;COLUMN POSITION OF LATEST SPACE.
	COLUMN:	0	;LOOK AHEAD COLUMN POSITION.
ENDR LNSCAN;9/20/73(BGB)---------------------------------------------
SUBR(LNJUST)	;LINE JUSTIFY AND PRINT.
;IMPLICIT ARGUMENTS:

	PTR←←14
	LAC COLMAX↔SUB SPACOL↔DAC EXTRA		;EXTRA SPACE.
	SKIPLE SPACNT↔SOS SPACNT↔DZM SPAFLG	;IGNORE LEADING SPACES.

;PRINT CHARACTERS  -  ADJUST SPACE SIZES.
L1:	LAC TXTPTR
	CAMN ENDPTR↔GO EOL	;TEST FOR END OF PARAGRAPH.
	CAMN  LNPTR↔GO EOL	;TEST FOR ABNORMAL END OF LINE.
	CALL(GETCHR)↔LAC TXTPTR	
	CAMN SPAPTR↔GO EOL	;TEST FOR NORMAL END OF LINE.
	CAIN 1,12↔GO L1		;IGNORE LINEFEEDS.
	CAIN 1,00↔GO L1		;IGNORE NULLS.
	CAIN 1,11↔LACI 1,40	;CONVERT TAB INTO A SPACE.
	CAIN 1,15↔LACI 1,40	;CONVERT CR  INTO A SPACE.
	CAIE 1,40↔DOM SPAFLG#
	CAIE 1,40↔DZM DOUBLE#			;NOT SPACE - RESET.
	CAIE 1,"."↔CAIN 1,"?"↔DOM DOUBLE#	;PERIOD OR QUESTION MARK.
	DAC  1,CHAR

;EXECUTE A FONT CHANGE.

;PRINT THE CHARACTER.
	CAIN 1,40↔GO L2
	CALL(PRINT)↔GO L1

;COMPUTE A VARIABLE SPACE SIZE.
L2:	AOSE SPAFLG↔GO L1		;IGNORE MULTIPLE SPACES.
	ZAC↔SKIPN SPACNT↔GO L3		;TEST FOR NO VARIABLE SPACES.
	LAC 0,EXTRA↔IDIV 0,SPACNT
	SOS SPACNT
	LAC 1,EXTRA↔SUB 1,0↔DAC 1,EXTRA

;PRINT A VARIABLE SPACE.
L3:	LAC 1,FONT
	SKIPN 1,FONTAB(1)↔HALT
	CAR 1,40(1)			;WIDTH OF NORMAL SPACE.
	SKIPE DOUBLE↔ASH 1,1		;DOUBLE WIDTH SPACE.
	ADD 1,0↔ADDM 1,COL		;ADVANCE COL VARIABLE SPACE.
	GO L1

;EXECUTE A CARRIAGE RETURN LINE FEED.
EOL:	LAC COLMIN↔DAC COL	;CARRIAGE RETURN.
	JCALL LFEED
DECLARE{EXTRA}
ENDR LNJUST;9/20/73(BGB)---------------------------------------------
SUBR(TJLINE)	;CENTER OR RIGHT JUSTIFY A LINE OF TEXT.
;--------------------------------------------------------------------
;SKIP OVER LEADING BLANKS.
	DZM TOTAL
	PUSH P,TXTPTR↔PUSH P,CHRCNT	;SAVE SCANNER POSITION.
	CALL(GETCHR)↔CAIE 1,40↔GO L1+1
	POP P,0↔POP P,0↔GO TJLINE	;FLUSH THE STACK.
;FETCH A CHARACTER AND DO CONVERSIONS.
L1:	CALL(GETCHR)
	CAIN 1,00↔GO L1			;IGNORE NULLS.
	CAIN 1,11↔LACI 1,40		;CONVERT TABS TO BLANKS.
;LINE TERMINATION ON CR OR ESCAPE
	CAIN 1,15↔GO L2
	CAMN 1,ESC↔GO L2
;ACCUMULATE CHARACTER WIDTH INTO TOTAL.
	LAC 2,FONT↔LAC 2,FONTAB(2)	;FONT BASE ADDRESS.
	ADD 2,1↔CAR 0,(2)		;WIDTH OF CHARACTER.
	ADDM 0,TOTAL↔GO L1
;SET COLUMN FOR CENTER OR RIGHT JUSTIFICATION.
L2:	LAC COLMAX↔SUB COLMIN↔SUB TOTAL	;EXTRA SPACE IN XGP UNITS.
	LACM↔SKIPGE TJFLAG↔ASH -1	;HALVE WHEN CENTERING.
	ADD COLMIN↔DAC COL
	DZM TJFLAG
;RESTORE THE SCANNER AND EXIT.
	POP P,CHRCNT↔POP P,TXTPTR
	POP0J
DECLARE{TOTAL}
ENDR TJLINE;9/23/73(BGB)---------------------------------------------
SUBR(DEFONT)	DEFINE FONT NUMERAL N; TAKES N FROM AC-1.
;--------------------------------------------------------------------
	DZM FILNAM		      ;ENTRY   - SCAN FOR FILENAME.
	INIT 1,17↔SIXBIT/DSK/↔0	      ;ENTRY+1 - DON'T SCAN FILENAME.
	GO[FATAL(CAN'T INIT DSK)]↔DAC 1,FONTCH
	SKIPE FILNAM↔GO L1
	CALL(GETCHR)↔ANDI 1,17↔DAC 1,FONT	;FONT NUMERAL.
	CALL(GETFIL)↔GO L3			;FONT FILE NAME.

;FIND FONT FILE.
L1:	LOOKUP 1,FILNAM↔GO[
	  LACI'FNT'↔SKIPN EXTION↔DIPZ EXTION
	  LOOKUP 1,FILNAM↔GO[
	    LAC FNTPPN↔SKIPN PPPN↔DAC PPPN
	    LOOKUP 1,FILNAM↔GO[
	      OUTSTR[ASCIZ/ FONT NOT FOUND.
/]↔	GO L3]↔GO .+1]↔GO .+1]

L2:	LAC 1,FONT			;FONT NUMBER.
	LAC MAXADR↔DAC FONTAB(1)	;FONT BASE ADDRESS.
	HLL PPPN↔SOS↔DAC INARG		;IOWD DUMP ARGUMENT.
	MOVS PPPN↔MOVMS↔ADD MAXADR↔AOS	;TOP OF THE FONT.
	DAC MAXADR↔CORE2↔HALT		;EXPAND UPPER SEGMENT.
	IN 1,INARG
	CALL(SETFNT)
L3:	RELEASE 1,
	POP0J
↑FONTCH: 0
MAXADR:	 %+4000				;MAXIMUM ADDRESS SO FAR.
INARG:0↔0
ENDR DEFONT;2/7/73(TVR)2/25/73(BGB)----------------------------------
SUBR(SETFNT)	SETUP A FONT, IMPLICIT ARGUMENT FONT.
;--------------------------------------------------------------------
	LAC 1,FONT↔CDR 2,FONTAB(1)	;GET FONT BASE ADDRESS.
	SKIPN 2↔POP0J			;EXIT WHEN FONT MISSING.
	
	LACI =40↔DAC DROW		;LINE FEED DEFAULT.
	SKIPE 1,201(2)↔DAC 1,DROW	;LINE FEED SPECIFIED.
	LAC XLINE↔ADDM DROW		;INTER LINE SPACING.

	LACI =25↔DAC DCOL		;SPACE DEFAULT.
	SKIPE 1,202(2)↔DAC 1,DCOL	;SPACE SPECIFIED.

	POP0J
ENDR SETFNT;2/7/72(TVR)-------------------------------------------

XFONT:	CALL(GETCHR)↔DZM CMODE
	CAIN  1,"."↔GO XFONT2	;NO CHANGE.
	CAIGE 1,"0"↔GO XFONT2
	CAIG  1,"9"↔ANDI 1,17
	CAIL  1,"A"↔GO[ANDI 1,37↔ADDI 1,=9↔GO .+1]
	DAC 1,FONT↔SKIPE FONTAB(1)↔GO XFONT2	;IS IT LOADED YET.
	LAC FNTNAM(1)↔DAC FILNAM
	LAC[SIXBIT/FNT/]↔DAC EXTION
	LAC FNTPPN↔DAC PPPN
	CALL(<DEFONT+1>)
XFONT2:	SKIPE TJFLAG↔CALL(TJLINE)	;CENTER & RIGHT JUSTIFY.
	POP0J
;--------------------------------------------------------------------
;FONT SELECT DELIMITERS.
	FSD:BLOCK 7
;FIVE PAIRS: {} () [] ⊂⊃ ≤≥

;DECLARE FONT SELECT DELIMITER  -  COMMANDS  {N; (N; [N; ⊂N; ≤N;
DFS:	GO .+6↔GO .+5↔GO .+4
	GO .+3↔GO .+2↔GO .+1
	SUBI DFS↔ADDI FSD
	CALL(GETCHR)
	CAIGE 1,"0"↔POP0J
	CAIG  1,"9"↔ANDI 1,17
	CAIL  1,"A"↔GO[ANDI 1,37↔ADDI 1,=9↔GO .+1]
	DIP 1,@↔SKIPE FONTAB(1)↔POP0J	;IS IT LOADED YET.
	PUSH P,FONT↔DAC 1,FONT
	LAC FNTNAM(1)↔DAC FILNAM
	LAC[SIXBIT/FNT/]↔DAC EXTION
	LAC FNTPPN↔DAC PPPN
	CALL(<DEFONT+1>)↔POP P,FONT
	POP0J

;LEFT FONT SELECT DELIMITER - TEXT MODE SELECT FONT.
LFS:	GO .+6↔GO .+5↔GO .+4
	GO .+3↔GO .+2↔GO .+1
	SUBI LFS↔ADDI FSD
	CAR 1,@↔SKIPN 1↔GO[AOS(P)↔POP0J]
	EXCH 1,FONT↔DAP 1,@	;SAVE RETURN FONT NUMBER.
	CALL(SETFNT)
	POP0J

;RIGHT FONT SELECT DELIMITER - TEXT MODE  RESTORE FONT.
RFS:	GO .+6↔GO .+5↔GO .+4
	GO .+3↔GO .+2↔GO .+1
	SUBI RFS↔ADDI FSD
	CDR 1,@↔SKIPN 1↔GO[AOS(P)↔POP0J]
	DAC 1,FONT
	CALL(SETFNT)
	POP0J
SUBR(MKSEG0)	MAKE LINE SEGMENT.  CLIPPER.
;--------------------------------------------------------------------
	ACCUMULATORS{R1,C1,R2,C2,Q,N}
;TEST FOR EASY OUTSIDER.
	LAC Q,C1↔LAC N,C2↔CAMLE C1,C2↔EXCH Q,N
	CAIG Q,=1727↔SKIPGE N↔POP0J
	LAC Q,R1↔LAC N,R2↔CAMLE R1,R2↔EXCH Q,N
	CAMG Q,QHI↔CAMGE N,QLO↔POP0J
;TEST FOR EASY INSIDER.
	JUMPL C1,L1↔JUMPL C2,L1
	CAILE C1,=1727↔GO L1↔CAILE C2,=1727↔GO L1
	CAMLE R1,QHI↔GO L1↔CAMLE R2,QHI↔GO L1
	CAMGE R1,QLO↔GO L1↔CAMGE R2,QLO↔GO L1↔GO MKSEG1	;DISPLAY.
;TEST FOR AND HANDLE SIMPLE CASES.
L1:	CAMN R1,R2↔GO[
	CAMN C1,C2↔POP0J↔GO HSEG]
	CAMN C1,C2↔GO VSEG
;MIDPOINT THE HARD CASE.
	PUSH P,R1↔PUSH P,C1	;SAVE 1ST END.
	ADD R1,R2↔ASH R1,-1	;MIDPOINT THE LINE SEGMENT.
	ADD C1,C2↔ASH C1,-1
;TEST FOR MIDPOINT AND 1ST END BEING COINCIDANT.
	CAMN R1,-1(P)↔GO[
	CAME C1, 0(P)↔GO .+1↔POP P,C1↔POP P,R1↔POP0J]
;RECURSION - DISPLAY ONE HALF AND THEN DISPLAY THE OTHER.
	CALL(MKSEG0)			;MIDPOINT TO 2ND END.
	LAC R2,-1(P)↔LAC C2,0(P)   
	CALL(MKSEG0)			;MIDPOINT TO 1ST END.
	POP P,C1↔POP P,R1↔POP0J
;DISPLAY HORIZONTAL LINE SEGMENT FROM (C1 MIN C2) TO (C1 MAX C2).
HSEG:	LAC Q,C1↔LAC N,C2↔CAML C1,C2↔EXCH N,Q
	SKIPGE Q↔SETZ Q,↔CAILE N,=1727↔LACI N,=1727↔SUB N,Q
	DOT(R1,Q)↔SKIPA↔IDPB 0,1↔SOJG N,.-1↔POP0J
;DISPLAY VERTICAL LINE SEGMENT FROM (R1 MIN R2) TO (R1 MAX R2).
VSEG:	LAC Q,R1↔LAC N,R2↔CAML R1,R2↔EXCH N,Q
	CAMGE Q,QLO↔LAC Q,QLO↔CAMLE N,QHI↔LAC N,QHI↔SUB N,Q
	DOT(Q,C1)↔ADDI 1,WWIDTH
	SOJG N,.-2↔POP0J
ENDR MKSEG0;4/24/73(BGB)---------------------------------------------
SUBR(MKSEG1)	MAKE LINE SEGMENT.
;--------------------------------------------------------------------
COMMENT / Recursive midpoint method of quantizing a line segment.
Arguments are expected in accumulators R1, C1, R2, C2; the bit
is deposited from accumulator 0./
	ACCUMULATORS{R1,C1,R2,C2,Q,N}

;TEST FOR AND HANDLE SIMPLE CASES.
	LAC 1,R1↔SUB 1,R2↔MOVMS 1↔CAIGE 1,2↔GO[
	    CAMN C1,C2↔GO[DOT(R1,C1)↔POP0J]↔GO HSEG]
	LAC 1,C1↔SUB 1,C2↔MOVMS 1↔CAIGE 1,2↔GO VSEG

;MIDPOINT THE HARD CASE.
	PUSH P,R1↔PUSH P,C1	;SAVE 1ST END.
	ADD R1,R2↔ASH R1,-1	;MIDPOINT THE LINE SEGMENT.
	ADD C1,C2↔ASH C1,-1

;TEST FOR MIDPOINT AND 1ST END BEING COINCIDANT.
	CAMN R1,-1(P)↔GO[
	CAME C1, 0(P)↔GO .+1↔POP P,C1↔POP P,R1
	DOT(R1,C1)↔DOT(R2,C2)↔POP0J]

;RECURSION - DISPLAY ONE HALF AND THEN DISPLAY THE OTHER.
	CALL(MKSEG1)			;MIDPOINT TO 2ND END.
	LAC R2,-1(P)↔LAC C2,0(P)   
	CALL(MKSEG1)			;MIDPOINT TO 1ST END.
	POP P,C1↔POP P,R1↔POP0J

;DISPLAY HORIZONTAL LINE SEGMENT FROM (C1 MIN C2) TO (C1 MAX C2).
HSEG:	LAC Q,C1↔LAC N,C2
	CAML C1,C2↔EXCH N,Q↔SUB N,Q
	DOT(R1,Q)↔SKIPA↔IDPB 0,1
	SOJG N,.-1↔POP0J

;DISPLAY VERTICAL LINE SEGMENT FROM (R1 MIN R2) TO (R1 MAX R2).
VSEG:	LAC Q,R1↔LAC N,R2
	CAML R1,R2↔EXCH N,Q↔SUB N,Q
	DOT(Q,C1)↔ADDI 1,WWIDTH
	SOJG N,.-2↔POP0J
ENDR MKSEG1;4/24/73(BGB)---------------------------------------------
SUBR(IIISIM)	OUTPUT III BUFFER ONTO XGP.
;--------------------------------------------------------------------
	ACCUMULATORS{X,Y,R,C,IIIWRD}

;DELTA ORIGIN DISPLACEMENT.
	SLACI 1,(2B2)↔LAC CHAR
	CAIN"*"↔SETZ 1,↔DAC 1,DELTA

;III FILE NAME.
	CALL(GETFIL)↔POP0J
	INIT 17,17↔SIXBIT/DSK/↔0
	GO[FATAL(CAN'T INIT DSK)]
	LOOKUP 17,FILNAM↔GO[LAC[SIXBIT/PLT/]↔DAC EXTION
	LOOKUP 17,FILNAM↔GO[LAC[SIXBIT/III/]↔DAC EXTION
	LOOKUP 17,FILNAM↔GO[LAC[SIXBIT/DAT/]↔DAC EXTION
	LOOKUP 17,FILNAM↔GO[LAC[SIXBIT/TMP/]↔DAC EXTION
	LOOKUP 17,FILNAM↔GO[FATAL<III OR VIDEO FILE NOT FOUND.>]
	GO L0]↔GO L0]↔GO L0]↔GO L0]

;EXPAND CORE FOR DUMP INPUT.
L0:	LAC JOBREL↔DAC OLD44#
	NIP 1,PPPN↔MOVN 1,1
	ADD 1,JOBREL↔DAC 1,BUFEND#
	CORE 1,↔GO[FATAL(CAN'T EXPAND CORE)]

;SAVE CURRENT XGP BEAM POSITION.
	LAC FONT↔DAC BEGFNT#
	LAC COL↔DAC BEGCOL#
	LAC ROW↔DAC BEGROW#
	LACI 2↔DAC IIISIZ	;INITIAL III CHARACTER SIZE.
;DUMP III FILE IN.
	LAC OLD44↔ADDM PPPN↔IN 17,PPPN
	LAC 1,OLD44↔LAC(1)↔CAMN[-1]↔GO VIDEO	;TEST 1ST WORD = -1.
	LAC 1,OLD44↔ADDI 1,2↔DAC 1,PC#		;III PC.
L1:	CDR 1,BUFEND↔DZM -1(1)↔DZM(1)
        CAML 1,JOBREL↔GO .+3
	LIPI 1,-1(1)↔BLT 1,JOBREL		;CLEAR TOP.
	;FETCH AND DECODE III COMMAND WORD.
ILOOP:	AOSA 1,PC
LOOP:	LAC 1,PC↔CAMLE 1,JOBFF
	CAML 1,BUFEND↔GO RET
	LAC  IIIWRD,(1)
	TRNE IIIWRD,01↔GO XTEXT		;TEXT COMMAND WORD.
	TRNE IIIWRD,02↔GO XVECTR	;VECTOR COMMAND WORD.
	TRNE IIIWRD,20↔GO XCTRL		;III CONTROL WORD.
	TRNE IIIWRD,37↔GO ILOOP		;NOP & HALT COMMANDS.
RET:	LAC OLD44↔CORE↔GO[FATAL(CAN'T SHRINK CORE!)]
FRET:	RELEASE 17,
	LAC BEGFNT↔DAC FONT
	LAC BEGCOL↔DAC COL
	LAC BEGROW↔DAC ROW
	POP0J

;EXECUTE III TEXT.
XTEXT:	PUSH P,IIIWRD			;-2(P)
	PUSH P,[5]			;-1(P)
	PUSH P,[POINT 7,-2(P)]		; 0(P)
CLOOP:	ILDB 1,0(P)↔JUMPE 1,CCONT↔DAC 1,CHAR
	CAIN 1,15↔GO[
		LAC 1,IIISIZ↔LAC 1,CHRWID(1)↔ROT 1,-12
		MOVNS 1↔ADDM 1,YBEAM
		LAC 1,[-511]↔DAC 1,XBEAM↔GO CCONT]
	PUSH P,ROW↔PUSH P,COL	;SAVE XGP-BEAM POSITION.

;COMPUTE XGP ROW AND COLUMN.
	LACN R,YBEAM↔ADD R,DELTA↔MUL R,IIIDY↔ADD R,BEGROW↔DAC R,ROW
	LAC  C,XBEAM↔ADD C,DELTA↔MUL C,IIIDX↔ADD C,BEGCOL↔DAC C,COL
	LAC 1,IIISIZ↔LAC 1,CHRWID(1)↔ROT 1,-13↔ADDM 1,XBEAM

;COMPUTE FONT SIZE.
	LAC 1,IIISIZ↔LAC CHRWID(1)↔FLOAT↔FMP SCALEX↔FIXX↔LACI 1,1
	CAIL 0,=7↔AOS 1
	CAIL 0,=20↔AOS 1↔CAIL 0,=25↔AOS 1
	CAIL 0,=30↔AOS 1↔CAIL 0,=40↔AOS 1
	CAIN 1,1↔GO[LAC 1,CHAR↔SETO↔CAIN 1,40↔GO CCONT2
		LAC R,ROW↔LAC C,COL
		CAMG R,QHI↔CAMGE R,QLO↔GO CCONT2
		DOT(R,C)↔GO CCONT2]
	CAMN 1,FONT↔GO CCONT3↔DAC 1,FONT
	SKIPE FONTAB(1)↔GO CCONT4
	DAC 1,FONT↔LAC FNTNAM(1)↔DAC FILNAM
	LAC[SIXBIT/FNT/]↔DAC EXTION
	LAC FNTPPN↔DAC PPPN
	CALL(<DEFONT+1>)
CCONT4:	LAC 1,FONT↔CALL(SETFNT)
CCONT3:	LAC 1,CHAR↔CALL(PRINT)
CCONT2:	POP  P,COL↔POP  P,ROW	;RESTORE XGP-BEAM POSITION.
CCONT:	SOSLE -1(P)↔GO CLOOP
	SUB P,[XWD 3,3]
	GO ILOOP

;EXECUTE III CONTROL OPERATIONS.
XCTRL:	TRNN IIIWRD,04↔GO[CAR 1,IIIWRD↔DAC 1,PC↔GO LOOP]  ;JUMP.
	TRNE IIIWRD,40↔GO LOOP			;SAVE A NOP HERE
	AOS 1,PC	;JSR
	HRLI 1,20
	CAR 2,IIIWRD
	CAMLE 2,JOBFF
	CAML 2,BUFEND↔GO[ OUTSTR[ASCIZ/JSR OUT OF BOUNDS
/]↔	GO RET]
	DAC 1,(2)↔DAC 2,PC
	GO ILOOP
	;EXECUTE VECTORS.
XVECTR:	TRNN IIIWRD,4
	GO [TRNN IIIWRD,10	;SHORT VECTOR OR TSS
	    GO SVECT		;SHORT VECTOR
	    GO ILOOP]		;TSS
	LDB [POINT 11,IIIWRD,10]↔ROT -13↔DAC X		;X FIELD.
	LDB [POINT 11,IIIWRD,21]↔ROT -13↔DAC Y		;Y FIELD
	LDB [POINT  3,IIIWRD,24]↔SKIPE↔DAC IIIBRT	;BRIGHTNESS
	LDB [POINT  3,IIIWRD,27]↔SKIPE↔DAC IIISIZ	;CHR SIZE
	LDB 1,[POINT 3,IIIWRD,31]↔CALL(VECTOR)		;OP CODE.
	GO ILOOP

SVECT:	PUSH P,IIIWRD				;SAVE III COMMAND.
	LDB [POINT 7,IIIWRD,06]↔ROT -7↔ASH -4↔DAC X	;X FIELD.
	LDB [POINT 7,IIIWRD,13]↔ROT -7↔ASH -4↔DAC Y	;Y FIELD.
	LDB 1,[POINT 2,IIIWRD,15]↔CALL(VECTOR)		;OP CODE.
	POP P,IIIWRD				;RESTORE III COMMAND.
	LDB [POINT 7,IIIWRD,22]↔ROT -7↔ASH -4↔DAC X	;X FIELD.
	LDB [POINT 7,IIIWRD,29]↔ROT -7↔ASH -4↔DAC Y   	;Y FIELD.
	LDB 1,[POINT 2,IIIWRD,31]↔CALL(VECTOR)		;OP CODE.
	GO ILOOP

VECTOR:	SETO↔TRNE 1,2↔SETZ		;SKIP ON VISIBLE VECTOR.
	TRNE 1,4↔GO .+3			;SKIP ON RELATIVE VECTOR.
 	ADD X,XBEAM↔ADD Y,YBEAM
	DAC X,XBEAM↔DAC Y,YBEAM
	LACN R,Y↔ADD R,DELTA↔MUL R,IIIDY↔ADD R,BEGROW	;Y INTO ROW.
	LAC  C,X↔ADD C,DELTA↔MUL C,IIIDX↔ADD C,BEGCOL	;X INTO COL.
	TRNE 1,1↔GO VPOINT		;SKIP NOT POINT VECTOR.
	LAC 2,ROW↔LAC 3,COL		;FROM OLD XGP BEAM POSITION.
	DAC R,ROW↔DAC C,COL		;SAVE NEW XGP BEAM POSITION.
	SKIPE↔CALL(MKSEG0)↔POP0J	;PLOT VECTOR - POP STACK.

;PLOT A DOT 3 BY 3.
VPOINT:	SOS R↔DAC R,ROW↔SOS C↔DAC C,COL	;SAVE NEW XGP BEAM POSITION.
	CAML R,QLO↔CAMLE R,QHI↔POP0J
	SETO↔DOT(R,C)↔AOS C↔DOT(R,C)

	LAC R,ROW↔LAC C,COL↔ADDI R,1
	CAML R,QLO↔CAMLE R,QHI↔POP0J
	SETO↔DOT(R,C)↔AOS C↔DOT(R,C)↔AOS C↔DOT(R,C)

	LAC R,ROW↔LAC C,COL↔ADDI R,2
	CAML R,QLO↔CAMLE R,QHI↔POP0J
	SETO↔DOT(R,C)↔AOS C↔DOT(R,C)↔AOS C↔DOT(R,C)↔POP0J

DECLARE{XBEAM,YBEAM,IIIBRT,IIISIZ}
CHRWID:	0↔8↔12↔14↔16↔24↔32↔48		;III CHARACTER WIDTHS.
ENDR IIISIM;2/8/73(TVR)8/21/73(BGB)----------------------------------
DELTA:	0
SUBR(VIDEO)
;--------------------------------------------------------------------
COMMENT⊗ VIDEO FILE HEADER
	0	-1
	1	6	BITS PER BYTE.
	2	=48	WORDS PER ROW.
	3	R1
	4	R2
	5	C1
	6	C2
	7	-WC,,ADR ⊗
	ACCUMULATORS{S2,S3,I,J,K,Q,P1,P2,R,C,TV}
;EXPECT AC-1 TO CONTAIN POINTER TO WORD ZERO OF VIDEO FILE IN CORE.
	LAC TV,1↔LAC 2(TV)↔DAC TVWIDTH#
	LAC 4(TV)↔SUB 3(TV)↔AOS↔DAC TVROWS#↔DZM TVROW0#
	LAC 6(TV)↔SUB 5(TV)↔AOS↔DAC TVCOLS#
	LAC R,ROW↔SKIPN DELTA↔GO[LAC TVROWS↔ASH 1↔SUB R,0↔GO .+1]
	TRZ R,3    		;UPPER LEFT MOST CORNER OF IMAGE.
	CAMLE R,QHI↔POP0J    ;WHOLE VIDEO IMAGE BELOW THIS QPAGE.
	CAML R,QLO↔GO L0     ;VIDEO IMAGE STARTS ON THIS QPAGE.
;VIDEO IMAGE STARTS BEFORE THIS QUARTER PAGE.
L00:	SUB R,QLO↔ASH R,-2
	MOVM R,R↔DAC R,TVROW0#
	CAML R,TVROWS↔POP0J  ;WHOLE VIDEO IMAGE ABOVE THIS QPAGE.
	SUB R,TVROWS
	DACM R,TVROWS↔LAC R,QLO
;VIDEO BYTE POINTER.
L0:	LAC P1,1(TV)		;BYTE SIZE.
	IORI P1,4400↔ROT P1,-=12
	LAP P1,7(TV)↔ADD P1,1	;ORIGIN OF VIDEO IN CORE.
	LAC TVROW0↔IMUL TVWIDTH↔ADD P1,0
;POINTER INTO XGP BUFFER.
	LAC C,COL↔SKIPN DELTA↔GO[LAC TVCOLS↔ASH 1↔SUB C,0↔GO .+1]
	HLLZ 1,%(C)↔ROT 1,6
	HRRI 1,@%(R)↔CDR P2,1
;J = COLUMNS/9			9 4-BIT XGP BYTES PER WORD.
	LACI J,=36↔IDIV J,1(TV)
	IMUL J,2(TV)↔IDIVI J,=9↔DAC J,JSAV#	;COLUMNS/9
	LAC I,TVROWS
L1:	DAC P2,P2SAV#↔LAC J,JSAV
L2:	SETZB 0,1↔SETZB 2,3↔LACI K,=9
L3:	ILDB Q,P1
	TRZ Q,3↔ROTC 0,4↔ROTC 2,4
	IOR 0,HTT+0(Q)↔IOR 1,HTT+1(Q)
	IOR 2,HTT+2(Q)↔IOR 3,HTT+3(Q)↔SOJG K,L3
	CAIL C,=1728↔GO L4
	IORM 0,0*WWIDTH(P2)↔IORM 1,1*WWIDTH(P2)
	IORM 2,2*WWIDTH(P2)↔IORM 3,3*WWIDTH(P2)
L4:	AOS P2↔SOJG J,L2
	ADDI R,4↔CAMLE R,QHI↔POP0J
	LAC P2,P2SAV↔ADDI P2,4*WWIDTH
	SOJG I,L1
	POP0J
;HALF TONE TABLE.
HTT:	6↔7↔7↔6↔	6↔6↔7↔6↔	6↔6↔6↔6↔	6↔6↔6↔6
	6↔6↔6↔4↔	4↔6↔6↔4↔	4↔6↔6↔4↔	4↔4↔6↔4
	4↔4↔4↔4↔	4↔4↔4↔4↔	0↔4↔4↔4↔	4↔4↔4↔0
	0↔4↔4↔0↔	0↔0↔4↔0↔	0↔0↔4↔0↔	0↔0↔0↔0
ENDR VIDEO;6/2/73(BGB)-----------------------------------------------
SUBR(GETFIL)	;GET FILE SPECIFICATION - SKIP OK.
;--------------------------------------------------------------------
;CLEAR FILENAME SPECIFICATION.
	DZM FILNAM
	DZM EXTION
	DZM EXTION+1
	DZM PPPN

;AC1-CHR, AC2-CNT, AC3, AC4-BP.
	LAC 4,[POINT 6,FILNAM,-1]↔LACI 2,6
L:	CALL(GETCHR)
	CAIN 1,15↔GO[CALL(GETCHR)↔GO EOL]
	CAILE 1,"z"↔POP0J
	CAIL 1,"a"↔SUBI 1,40		;CONVERT LOWER CASE
	CAIN 1,"."↔GO[LAC 4,[POINT 6,EXTION,-1]↔LACI 2,3↔GO L]
	CAIN 1,"["↔GO[LAC 4,[POINT 6,PPPN,-1]  ↔LACI 2,3↔GO L]
	CAIN 1,","↔GO[LAC 4,[POINT 6,PPPN,17]  ↔LACI 2,3↔GO L]
	CAIN 1,"]"↔CALL(GETCHR)
	CAIN 1,";"↔GO EOL	;XAP COMMAND POSTFIX.
	CAIG 1," "↔GO EOL
	SOJL 2,L↔SUBI 1,40	;COUNT'EM AND CONVERT TO SIXBIT.
	IDPB 1,4↔GO L		;PACK CHARACTER INTO SPECIFICATIONS.
EOL:	
	CAR PPPN↔TRNN 77↔LSH -6↔TRNN 77↔LSH -6↔DIP PPPN
	CDR PPPN↔TRNN 77↔LSH -6↔TRNN 77↔LSH -6↔DAP PPPN
	AOS(P)↔POP0J
ENDR GETFIL;5/30/73(BGB)---------------------------------------------
SUBR(GETCHR)	GET A CHARACTER FROM THE TEXT BUFFER.
	SOSGE CHRCNT↔GO .+3
	ILDB 1,TXTPTR↔POP0J
	SETOM EOF↔SETZ 1,
	POP0J
ENDR GETCHR;5/30/73(BGB)---------------------------------------------

SUBR(GETNUM)	GET AN INTEGER.
	SETZM↔CALL(GETCHR)
	CAIL 1,"0"↔CAILE 1,"9"↔GO[
	EXCH 1,0↔POP0J]↔ANDI 1,17
	IMULI 0,=10↔ADD 0,1
	GO GETNUM+1
ENDR GETNUM;---------------------------------------------------------

SUBR(GET14)	GET A 14 BIT NUMBER
	CALL(GETCHR)↔LSH 1,7↔PUSH P,1
	CALL(GETCHR)↔ADD 1,(P)↔POP P,(P)
	POP0J
ENDR GET14;----------------------------------------------------------

SUBR UNGETCHR
	AOS CHRCNT
	SETZM EOF
	MOVSI 070000
	ADDM TXTPTR
	POP0J
ENDR UNGETCHR;17-MAR-74(TVR)
SUBR(INFILE)	INDIRECT FILE COMMAND "@".
;--------------------------------------------------------------------

;FILE INITIALIZATION.
	PUSH P,TXTPTR			;SAVE TEXT POINTER.
	INIT 1,17↔SIXBIT/DSK/↔0
	GO[FATAL(CAN'T INIT DSK)]
	CALL(GETFIL)↔POP0J
	LOOKUP 1,FILNAM↔GO L1

;WIPE OUT INDIRECT COMMAND.
	POP P,1↔ADD 1,[7B5]	;DECREMENT OLDE TEXT POINTER.
	LACI"F"↔IDPB 0,1
	LACI"."↔IDPB 0,1
	DAPZ 1,PTR1#
 	SETZ↔IDPB 0,1
	CAME 1,TXTPTR↔GO .-2
	DAPZ 1,PTR2#
	
;EXPAND CORE WHEN NECESSARY.
	NIP PPPN↔MOVMS↔DAC SIZE#		;WORD COUNT.
	IMULI =5↔ADDM CHRCNT↔ADDM SAVCNT	;NEW CHARACTER COUNT.
	LAC 1,TXTEND↔ADD 1,SIZE↔DAC 1,NEWEND#	;NEW TOP OF CORE.
	CDR 1,NEWEND↔CAMG 1,JOBREL↔GO .+3
	CORE 1,↔GO[FATAL(<NO ROOM FOR TEXT.>)]

;MOVE TOP OF TEXT BUFFER UP CORE.
	SETO 1,↔LAP 1,TXTEND
	LAC SIZE↔DAP .+3
	CDR TXTEND↔SUB PTR2
	POP 1,SIZE(1)↔SOJG .-1

;STEP ON A FUNNY CASE.
	LAC 1,PTR1↔LAC 2,PTR2↔CAME 1,2↔GO L2
	ADD 2,SIZE↔LIPI 1,440700↔LIPI 2,440700
	SETZ 3,↔LACI 4,5
	ILDB 0,1↔IDPB 3,2	;CLEAR LEADING BYTES OF TWO.
	SOJLE 4,L2↔JUMPN  0,.-3
	IDPB 3,2↔SOJG 4,.-1	;CLEAR LAGGING BYTES OF ONE.
L2:

;INPUT THE FILE.
	LAC NEWEND↔DAC TXTEND
;	LAC PPPN↔LAP PTR1↔DAC DUMARG
	LAC PTR1↔LIPI 000700↔DAC TXTPTR↔HLL PPPN↔DAC DUMARG
	IN 1,DUMARG↔GO[ RELEASE 1, 
		SETZM CMODE			;ENTER TEXT MODE.
		POP0J ]
	FATAL(READ ERROR!)
DUMARG:0↔0
L1: 	OUTSTR[ASCIZ/FILE NOT FOUND  -  /]
	POP P,1↔LAC 2,[POINT 7,4]↔LACI 3,=25
	ILDB 1↔CAIN";"↔GO .+3↔IDPB 2↔SOJG 3,.-4
	SETZ↔IDPB 2↔OUTSTR 4↔CRLF↔EXIT
ENDR INFILE;5/30/73(BGB)---------------------------------------------
;COMMAND EXECUTION.
;--------------------------------------------------------------------
;ABSOLUTE INVISIBLE VECTOR.
AI:	CALL(GETNUM)↔DAC 1,ROW
	CALL(GETNUM)↔DAC 1,COL↔POP0J
;--------------------------------------------------------------------
;ABSOLUTE VISIBLE VECTOR.
AV:	CALL(GETNUM)↔DAC 1,4
	CALL(GETNUM)↔DAC 1,5
AV1:	SKIPE ARROW1↔GO[CALL(MKARROW,4,5)↔POP P,5↔POP P,4↔GO .+1]

	LAC 2,ROW↔LAC 3,COL
	DAC 4,ROW↔DAC 5,COL
	SKIPE ARROW2↔GO[CALL(MKARROW,2,3)↔POP P,3↔POP P,2↔GO .+1]

	LAC 4,ROW↔LAC 5,COL
	SETO↔CALL(MKSEG0)↔POP0J
;--------------------------------------------------------------------
;Loren Rush's ABSOLUTE VISIBLE VECTOR. (Like a locus statement!)
MUZAV:	CALL(REALIN)↔FADR[864.0]↔FIXX↔DAC 5
	CALL(REALIN)↔FSBR[1024.0]↔FIXX↔DACN 4
	CALL(UNGETCHR)	;Keep that break character!
	JRST AV1
;--------------------------------------------------------------------
XMARGN:	CALL(GETNUM)↔DAC 1,LMAR
	POP0J
XRADIAL:
	CALL(GETNUM)↔DAC 1,5↔FLOAT 5,↔DAC 5,4
	CALL(GETNUM)↔DAC 1,3↔FLOAT 3,↔DAC 3,2
	FMP 2,SINE↔MOVNS 2↔FIXX 2,↔ADD 2,ROW
	FMP 4,SINE↔MOVNS 4↔FIXX 4,↔ADD 4,ROW
	FMP 3,COSINE↔FIXX 3,↔ADD 3,COL
	FMP 5,COSINE↔FIXX 5,↔ADD 5,COL
	SETO↔CALL(MKSEG0)↔POP0J
;--------------------------------------------------------------------
SEMICO:	DZM ARROW1↔DZM ARROW2↔POP0J
;--------------------------------------------------------------------
XARROW:	CAIE 1,"↔"↔GO .+3
	SETOM ARROW1↔SETOM ARROW2
	CAIN 1,"←"↔SETOM ARROW1
	CAIN 1,"→"↔SETOM ARROW2
	POP0J

XARRLW:	CALL(REALIN)↔DAC ARROWW
	CALL(REALIN)↔DAC ARROWL
	POP0J

SUBR(MKARROW)ROW2,COL2
	LAC 0,ARG1↔SUB 0,COL↔FLOAT 0,↔DAC 0,10↔FMP 0,0
	LAC 1,ARG2↔SUB 1,ROW↔FLOAT 1,↔DAC 1,11↔FMP 1,1
	FAD 1,0↔CALL(SQRT,1)
	PUSH P,SINE↔PUSH P,COSINE	;SAVE OLDE ORIENTATION.
	LAC 10↔FDV 1↔DAC COSINE
	LAC 11↔FDV 1↔DACN SINE
	SETZB 2,3↔LAC 4,ARROWL↔LAC 5,ARROWW↔CALL(MKSEG3)
	SETZB 2,3↔LAC 4,ARROWL↔LACN 5,ARROWW↔CALL(MKSEG3)
	LAC 2,ARROWL↔LAC 3,ARROWW
	LAC 4,ARROWL↔LACN 5,ARROWW↔CALL(MKSEG3)
	POP P,COSINE↔POP P,SINE
	POP0J
ENDR MKARROW;--------------------------------------------------------
ARROW1:	0	;ARROW HEAD 1ST VERTEX - PREFIX FLAG.
ARROW2:	0	;ARROW HEAD 2ND VERTEX - PREFIX FLAG.
ARROWW:	15.0	;ARROW HALF WIDTH.
ARROWL:	45.0	;ARROW LENGTH.
;III DISPLAY SCALE FACTOR.
XXSCAL:	CALL(REALIN)↔DAC SCALEX
	FMPR[1024.]↔FIXX↔DAC IIIDX
	POP0J
YYSCAL:	CALL(REALIN)↔DAC SCALEY
	FMPR[1024.]↔FIXX↔DAC IIIDY
	POP0J
XROTAT:	CALL(READARC)↔DAC ROTDEL
	SETQ(SINE,{SIN,ROTDEL})
	SETQ(COSINE,{COS,ROTDEL})
	POP0J
;--------------------------------------------------------------------
XLOCUS:			;L<X>,<Y>
	CALL(REALIN)↔FADR[864.0]↔FIXX↔DAC COL
	CALL(REALIN)↔FSBR[1024.0]↔FIXX↔DACN ROW
	POP0J
SUBR(SQRT)
;MODIFIED OLDE LIB40 SQUARE ROOT - BGB - TRADITIONAL.
	A←0 ↔ B←←1 ↔ C←2
	MOVM B,ARG1↔JUMPE B,POP1J.↔PUSH P,2
;LET X=F*(2↑2B) WHERE 0.25<F<1.00 THEN SQRT(X)=SQRT(F)*(2↑B).
	ASHC B,-=27↔SUBI B,201	;GET EXPONENT IN B, FRACTION IN C.
	ROT B,-1		;CUT EXP IN HALF, SAVE ODD BIT
	HRRM B,L↔LSH B,-=35	;USE THAT ODD BIT.
	ASH C,-10↔FSC C,177(B)	;0.25 < FRACTION < 1.00
;LINEAR APPROXIMATION TO SQRT(F).
	MOVEM C,A
	FMP C,[0.8125↔0.578125](B)
	FAD C,[0.302734↔0.421875](B)
;TWO ITERATIONS OF NEWTON'S METHOD.
	MOVE B,A
	FDV B,C↔FAD C,B↔FSC C,-1
	FDV A,C↔FADR A,C
     L: FSC A,0↔MOVE 1,A↔POP P,2
	POP1J
ENDR SQRT;--------------------------------------------------------


BEGIN SINCOS		;SINE & COSINE - BGB.
INTERN SIN,COS;---------------------------------------------------
	A←←1 ↔ B←2 ↔ C←3
↑COS:	SKIPA A,ARG1
↑SIN:	SKIPA A,ARG1
	FADR  A,HALFPI			;COS(X) = SIN(X+π/2).
	MOVM B,A↔CAMG B,[17B5]↔POP1J	;FOR SMALL X, SIN(X)=X.
;B ← (ABS(X)MODULO 2π)/HALFPI
;C ← QUADRANT 0, 1, 2 OR 3.
	FDVR B,HALFPI
	LAC C,B↔FIX C,233000
	CAILE C,3↔GO[TRZ C,3↔FSC C,233
	FSBR B,C↔GO .-3]		;MODULO 2π.
	GO .+1(C)↔GO .+4↔JFCL↔GO[
	FSBRI B,(2.0)↔MOVNS B↔GO .+2]	;SIN(X+π)=SIN(-X)
	FSBRI B,(4.0)			;SIN(X+2π)=SIN(X)
	SKIPGE A↔MOVNS	B		;SIN(-X) = -SIN(X).
;FOR -1 ≤ B ≤ +1 REPRESENTING -π/2 ≤ X ≤ +π/2,
;COMPUTE SINE(X) APPROXIMATION BY TAYLOR SERIES.
	DAC B,C↔FMPR B,B	
	LAC A,[164475536722]↔FMP A,B
	FAD A,[606315546346]↔FMP A,B
	FAD A,[175506321276]↔FMP A,B
	FAD A,[577265210372]↔FMP A,B
	FAD A,HALFPI↔FMPR A,C↔POP1J
HALFPI:	201622077325↔LIT ;PI/2
BEND;-------------------------------------------------------------
READARC:	;AND REALIN.
	CALL(REALIN)↔JUMPL[CAMG[6.3]↔FMPR[0.0174533]↔POP0J]
	CAML[6.3]↔FMPR[0.0174533]↔POP0J
SUBR(REALIN)
;--------------------------------------------------------------------
;<EXPR>		::= <EXPR>+<TERM>|<EXPR>-<TERM>|<TERM>
;<TERM>		::= <TERM>*<PRIMARY>|<TERM>/<PRIMARY>|<PRIMARY>
;<PRIMARY>	::= -<PRIMARY>|(<EXPR>)||π|<REAL NUMBER>
	CALL(TERM)
	CAIN 1,"+"↔GO[
		PUSH P,0↔CALL(TERM)↔FADR 0,(P)
		SUB P,[XWD 1,1]↔GO REALIN+1]
	CAIN 1,"-"↔GO[
		PUSH P,0↔CALL(TERM)↔MOVN 0,0↔FADR 0,(P)
  	     	SUB P,[XWD 1,1]↔GO REALIN+1]
	POP0J↔POP0J
TERM:	CALL(PRIMARY)
TERM2:	CAIN 1,"*"↔GO[
		PUSH P,0↔CALL(PRIMARY)↔FMPR 0,(P)
		SUB P,[XWD 1,1]↔GO TERM2]
	CAIN 1,"/"↔GO[
		PUSH P,0↔CALL(PRIMARY)↔EXCH 0,(P)↔FDVR 0,(P)
		SUB P,[XWD 1,1]↔GO TERM2]
	POP0J
;BEGIN REALIN	; INPUT SMALL REAL NUMBER - BGB - 16 DEC 1972
;AC-0 INTEGER ACCUMULATION.	AC-0 RETURNS REAL NUMBER.
;AC-1 CHARACTER.		AC-1 RETURNS BREAK CHARACTER.
;AC-2 COUNTER OF DIGITS TO RIGHT OF DECIMAL POINT PLUS ONE.
;AC-3 MINUS SIGN FLAG.
PRIMARY:SETZ↔SETZB 2,3
L0:	CALL(GETCHR)
	CAIN 1," "↔GO .-2
	CAIN 1,"-"↔GO[SETCMM 3↔GO L0]
	CAIN 1,"π"↔GO[MOVE 0,[3.1415926]
	      GETRET: CALL(GETCHR)↔GO L3]
	CAIN 1,"("↔GO[PUSH P,3↔CALL(REALIN)↔POP P,3
		      CAIN 1,")"↔GO GETRET
		      OUTSTR[ASCIZ/WARNING: MISSING ')'
/]↔		      POP0J]
	SKIPA
L1:	CALL(GETCHR)
	CAIN 1,";"↔GO L2↔CAIN 1,","↔GO L2
	CAIE 1,"."↔GO .+3↔JUMPN 2,L2↔AOJA 2,L1
	CAIL 1,"0"↔CAILE 1,"9"↔GO L2
	JUMPN 2,[CAILE 2,4↔GO L1↔AOJA 2,.+1]
	ANDI 1,17↔IMULI =10↔ADD 1↔GO L1
L2:	FLOAT↔SOSLE 2↔FDVR[1.0↔10.0↔100.0↔1000.0↔10000.0](2)
L3:	SKIPE 3↔MOVNS↔POP0J
ENDR REALIN;12/16/72(BGB),14-MAR-73(TVR)-----------------------------
SUBR(DPYDOT)X,Y		;DISPLAY A DOT.
;--------------------------------------------------------------------
;PLACE A DOT AT LOCUS (X,Y).
;DILATION, ROTATION, TRANSLATION, & CLIP.
	ACCUMULATORS{R,C}
	LAC R,ARG1↔LAC C,ARG2
	FMP R,SCALEY↔LAC 0,R		;DILATION.
	FMP C,SCALEX↔LAC 1,C
	FMP 0,SINE↔FMP R,COSINE		;ROTATION.
	FMP 1,SINE↔FMP C,COSINE
	FADR R,1↔FSBR C,0↔MOVNS R
	FIXX R,↔ADD R,ROW		;TRANSLATION.
	FIXX C,↔ADD C,COL
	CAMGE R,QLO↔POP2J		;CLIP.
	CAMLE R,QHI↔POP2J
	SKIPGE C↔POP2J
	CAILE C,=1728
	SETO↔DOT(R,C)↔POP2J		;DISPLAY.
ENDR DPYDOT;5/29/73(BGB)---------------------------------------------
SUBR(MKSEG3)
;--------------------------------------------------------------------
	R←←2 ↔ C←←3
	EXCH R,C
	FMP R,SCALEY↔LAC 0,R		;DILATION.
	FMP C,SCALEX↔LAC 1,C
	FMP 0,SINE↔FMP R,COSINE		;ROTATION.
	FMP 1,SINE↔FMP C,COSINE
	FADR R,1↔FSBR C,0↔MOVNS R
	FIXX R,↔ADD R,ROW		;TRANSLATION.
	FIXX C,↔ADD C,COL
	R←←4 ↔ C←←5
	EXCH R,C
	FMP R,SCALEY↔LAC 0,R		;DILATION.
	FMP C,SCALEX↔LAC 1,C
	FMP 0,SINE↔FMP R,COSINE		;ROTATION.
	FMP 1,SINE↔FMP C,COSINE
	FADR R,1↔FSBR C,0↔MOVNS R
	FIXX R,↔ADD R,ROW		;TRANSLATION.
	FIXX C,↔ADD C,COL
	SETO↔GO MKSEG0
ENDR MKSEG3;_________________________________________________________
SUBR(XCONIC)		;E<A>,<B>,<X1>,<X2>;
;--------------------------------------------------------------------
	SLACI(<1.0>)
	CAIE 1,"H"↔MOVNS
	DAC ONE↔DZM FLAG#

	CALL(REALIN)↔DACM A#↔CAIN 1,";"↔GO[DOM FLAG↔DACM B↔DACN X1↔DACM X2↔GO L1]
	CALL(REALIN)↔DACM B#↔CAIN 1,";"↔GO[DOM FLAG↔LAC  A↔DACN X1↔DACM X2↔GO L1]
	CALL(REALIN)↔DAC X1#
	CALL(REALIN)↔DAC X2#

L1:	LACI CONIC↔DAP FN	;FUNCTION ARGUMENT.
	CALL(CONIC,X1)↔DAC 1,Y1#
	CALL(CONIC,X2)↔DAC 1,Y2#

	LAC 2,X1↔LAC 3,Y1
	LAC 4,X2↔LAC 5,Y2
	CALL(MKCURV)

	SKIPN FLAG↔POP0J
	MOVNS COSINE↔MOVNS SINE↔MOVNS FLAG		;PI ROTATION.
	SKIPG FLAG↔POP0J↔GO L1
	
CONIC:	LAC 1,ARG1↔FDV 1,A↔FMP 1,1
	FADR 1,ONE↔CALL(SQRT,1)↔FMP 1,B↔POP1J

ONE:	1.0
ENDR XCONIC;---------------------------------------------------------

	FN: GO		;FUN ARG PROBLEM.

SUBR(XBOX)
	ACCUMULATORS{X1,Y1,X2,Y2}
	CALL(REALIN) ↔ DACM PDX# ↔ DACN NDX# ↔ CAIE 1,";"
	CALL(REALIN) ↔ DACM PDY# ↔ DACN NDY# 
	LAC X1,NDX↔LAC Y1,NDY↔LAC X2,NDX↔LAC Y2,PDY↔CALL(MKSEG3) ;WEST.
	LAC X1,PDX↔LAC Y1,NDY↔LAC X2,PDX↔LAC Y2,PDY↔CALL(MKSEG3) ;EAST.
	LAC X1,NDX↔LAC Y1,NDY↔LAC X2,PDX↔LAC Y2,NDY↔CALL(MKSEG3) ;SOUTH.
	LAC X1,NDX↔LAC Y1,PDY↔LAC X2,PDX↔LAC Y2,PDY↔CALL(MKSEG3) ;NORTH.
	POP0J
ENDR XBOX

SUBR(XDIAMON)
	ACCUMULATORS{X1,Y1,X2,Y2}
	CALL(REALIN) ↔ DACM PDX# ↔ DACN NDX# ↔ CAIE 1,";"
	CALL(REALIN) ↔ DACM PDY# ↔ DACN NDY# 
	LAC X1,NDX↔LAC Y1,[0]↔LAC X2,[0]↔LAC Y2,PDY↔CALL(MKSEG3) ;NW
	LAC X1,PDX↔LAC Y1,[0]↔LAC X2,[0]↔LAC Y2,PDY↔CALL(MKSEG3) ;NE
	LAC X1,[0]↔LAC Y1,NDY↔LAC X2,PDX↔LAC Y2,[0]↔CALL(MKSEG3) ;SE
	LAC X1,[0]↔LAC Y1,NDY↔LAC X2,NDX↔LAC Y2,[0]↔CALL(MKSEG3) ;SW
	POP0J
ENDR XDIAMON

SUBR(XSWINE)		;MAKE BOX WITH ROUNDED CORNERS.
	ACCUMULATORS{X1,Y1,X2,Y2}

	CALL(REALIN) ↔ DACM PDX# ↔ DACN NDX#	;HALF WIDTH.
	CALL(REALIN) ↔ DACM PDY# ↔ DACN NDY# 	;HALF HEIGHT.
	CALL(REALIN) ↔ DACM RADY#↔DACM RADX#	;ROUNDING RADIUS.

	LAC X1,NDX↔LAC Y1,NDY↔FAD Y1,RADY
	LAC X2,NDX↔LAC Y2,PDY↔FSB Y2,RADY↔CALL(MKSEG3) ;WEST.

	LAC X1,PDX↔LAC Y1,NDY↔FAD Y1,RADY
	LAC X2,PDX↔LAC Y2,PDY↔FSB Y2,RADY↔CALL(MKSEG3) ;EAST.

	LAC X1,NDX↔FAD X1,RADX↔LAC Y1,NDY
	LAC X2,PDX↔FSB X2,RADX↔LAC Y2,NDY↔CALL(MKSEG3) ;SOUTH.

	LAC X1,NDX↔FAD X1,RADX↔LAC Y1,PDY
	LAC X2,PDX↔FSB X2,RADX↔LAC Y2,PDY↔CALL(MKSEG3) ;NORTH.

;ROUND THE CORNERS.
	LACI XFN↔DAP FN				;GIVE FUN ARG TO MKCURV.
	PUSH P,SINE↔PUSH P,COSINE		;SAVE ORIGINAL ORIENTATION.
	LAC ROW↔DAC R0#↔LAC COL↔DAC C0#		;SAVE ORIGINAL LOCATION.

	LAC PDX↔FSBR RADX↔FIXX↔DAC DC#
	LAC PDY↔FSBR RADY↔FIXX↔DAC DR#

	SETZM SINE↔LAC[1.0]↔DAC COSINE
	LAC R0↔SUB DR↔DAC ROW↔LAC C0↔ADD DC↔DAC COL↔CALL(SWNARC)

	SETZM COSINE↔LAC[1.0]↔DAC SINE
	LAC R0↔SUB DR↔DAC ROW↔LAC C0↔SUB DC↔DAC COL↔CALL(SWNARC)

	SETZM SINE↔LAC[-1.0]↔DAC COSINE
	LAC R0↔ADD DR↔DAC ROW↔LAC C0↔SUB DC↔DAC COL↔CALL(SWNARC)

	SETZM COSINE↔LAC[-1.0]↔DAC SINE
	LAC R0↔ADD DR↔DAC ROW↔LAC C0↔ADD DC↔DAC COL↔CALL(SWNARC)

;RESTORE THE GLOBALS
	LAC R0↔DAC ROW↔	LAC C0↔DAC COL
	POP P,COSINE↔POP P,SINE↔POP0J

XFN:	LAC 1,ARG1↔FDV 1,RADX↔FMP 1,1
	FADR 1,[-1.0]↔CALL(SQRT,1)↔FMP 1,RADY↔POP1J
SWNARC:	SETZ X1,
	LAC Y1,RADY↔LAC X2,RADX
	SETZ Y2,0↔CALL(MKCURV)↔POP0J
ENDR XSWINE
SUBR(MKCURV)
;--------------------------------------------------------------------
	ACCUMULATORS{X1,Y1,X2,Y2}

	PUSH P,X1↔PUSH P,Y1
	FADR X1,X2↔FSC X1,-1
	FADR Y1,Y2↔FSC Y1,-1
	CALL(FN,X1)↔EXCH 1,Y1

	FSB 1,Y1↔MOVMS 1↔CAMGE 1,[1.5]↔GO L1
	LAC 1,X1↔FSB 1,X2↔MOVMS 1↔CAMGE 1,[1.0]↔GO L1

	CALL(MKCURV)		;MIDPOINT TO 2ND END.
	LAC X2,-1(P)↔LAC Y2,0(P)
	CALL(MKCURV)		;MIDPOINT TO 1ST END.
	POP P,Y1↔POP P,X1↔POP0J

L1:	LAC X1,-1(P)↔LAC Y1,0(P)
	CALL(MKSEG3)
	POP P,Y1↔POP P,X1↔POP0J
ENDR MKCURV;_________________________________________________________
END SA